home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / PPC source / cg3 < prev    next >
Text File  |  1999-01-18  |  66KB  |  2,496 lines
  1. marker m__cg3
  2.  
  3. PPC?
  4. [IF]
  5. false    constant    debug?
  6. [ELSE]
  7. false    constant    debug?
  8. [THEN]
  9.  
  10.  
  11.  
  12. \        =========================================================
  13. \                            EQUALIZATION        
  14. \        =========================================================
  15. \
  16. \  See the notes in the doco section in cg1.
  17.  
  18.  
  19. forward  setup_normal_call
  20.  
  21.  
  22. false    value    forward?        \ true if we're compiling a FORWARD definition
  23. false    value    noname?            \ true if we're compiling a :NONAME defn
  24. false    value    mloc?            \ true if we're compiling a :MLOC
  25. false    value    entry?            \ true if we're compiling a :ENTRY
  26.  
  27.  
  28. 2    constant    gpr_call_cnt    \ the number of stack cells we pass in GPRs
  29.                                 \  for calls that don't have named parms
  30.  
  31. 2    constant    fpr_call_cnt    \ ditto for FPRs.  This is also the number of
  32.                                 \  floating stack cells we take to be in FPRs
  33.                                 \  on return, if there aren't any FP flag bytes.
  34.  
  35. 6    constant    max_gpr_rtn_cnt    \ the max number of stack cells we leave in
  36.                                 \  GPRs at EXIT time.  6 is enough, since any
  37.                                 \  more would probably have to get pushed off
  38.                                 \  to mem straight away by the caller.  And we
  39.                                 \  need at least one spare for equalization.
  40.                                 
  41. 6    constant    max_fpr_rtn_cnt    \ ditto for FPRs
  42.  
  43. max_GPR_rtn_cnt
  44.     constant    max_eq_cnt        \ the max number of GPRs we can equalize.
  45.                                 \  We must have one free for copying things
  46.                                 \  around.
  47.  
  48. 0    value        gpr_rtn_cnt        \ the actual no of stack cells we leave in GPRs
  49.                                 \  at EXIT time for the current defn.  We make
  50.                                 \  this variable to try to minimize reg
  51.                                 \  spills/refills.
  52.  
  53. 0    value        fpr_rtn_cnt        \ ditto for floating point.
  54.  
  55. 1    constant    fwd_gpr_rtn_cnt    \ for FORWARD defns, we have to use arbitrary values
  56.                                 \ for the return counts, since we'll be calling them
  57. fpr_call_cnt
  58.     constant    fwd_fpr_rtn_cnt    \ by using fpr_call_cnt for the FORWARD FP return
  59.                                 \  count, we don't need to store FP flag bytes
  60.                                 \  for FORWARD definitions.
  61.  
  62. 0    value    xalignment
  63.  
  64. 0    value    #extern_parm_cells    \ Set when we're compiling an external call.
  65.                                 \  This is the number of cells needed by
  66.                                 \  parameters.  Normally the parms must
  67.                                 \  start at r3 and go on up from there.
  68.  
  69. 0    value    #extern_FP_parms    \ Likewise - this is the number of FP parms
  70.                                 \  (these get loaded into the FPRs).
  71.  
  72. 0    value    #extern_result_cells    \ Likewise, for results.  Must be 0 or 1.
  73.  
  74. 0    value    #extern_FP_results        \ Likewise, for FP results.  Must be 0 or 1.
  75.  
  76. 0    value    extern_mask            \ has a 1 corresponding to each GPR that
  77.                                 \  gets a dummy value because the corresponding
  78.                                 \  parm is floating.
  79.  
  80. true    value    adjust_stks?
  81.  
  82. objPtr eq_regs  class_is ODs_class
  83.  
  84.  
  85. : refTypeErr        \ called from the default clause of various case
  86.                     \  statements below, that dispatch on a reference.
  87.     dup .
  88.     dup pullRef >
  89.     IF        225        \ "We can't take the address of a register object" (i.e. we
  90.                     \   can't equalize against it)
  91.     ELSE    221        \ "Impossible operand!"
  92.     THEN  die
  93. ;
  94.  
  95.  
  96. : FPerr                \ called if we're asked to equalize a GPR to an FPR
  97.                     \  for some strange reason
  98.         ." FP number on data stack??" cr
  99.     ." cstk:  " printall: cstk cr
  100.     ." cstk2: " printall: cstk2 cr
  101.     ." fcstk: " printall: fcstk cr
  102.     ." fcstk2:" printall: fcstk2 cr
  103. ;
  104.  
  105.  
  106. : ADJUST_STKS
  107.     debug? if
  108.         ." adjust_stks - stk_offset " stk_offset . ."  fstk_offset " fstk_offset . cr
  109.     then
  110.  
  111.     otAdd 0  setLiteralOp: instrn  drop
  112.     stk_offset
  113.     IF    SP_reg >RA: instrn  SP_reg >RD: instrn
  114.         stk_offset >lit: instrn
  115.         compile: instrn
  116.         0 -> stk_offset
  117.     THEN
  118.     fstk_offset
  119.     IF    FSP_reg >RA: instrn  FSP_reg >RD: instrn
  120.         fstk_offset >lit: instrn
  121.         compile: instrn
  122.         0 -> fstk_offset
  123.     THEN
  124. ;
  125.  
  126.  
  127. (*    GET_RTN_CNTS returns the count of stack cells in regs for an exit
  128.     from the current definition.  (We also make the decision here if this
  129.     is the first time.)
  130.  
  131.     For the FPRs, we now require a minimum of fpr_call_cnt.  This is so
  132.     that any word which does a non-FP Toolbox call won't end up with
  133.     a zero fpr_rtn_cnt, which might force all words calling it to have
  134.     this too, and all words calling them, etc. - resulting in dozens of 
  135.     words needing FP info bytes when none of them do any FP ops!
  136. *)
  137.  
  138. : GET_RTN_CNTS  ( -- gpr_rtn_cnt fpr_rtn_cnt )
  139.     debug? if
  140.         ." get_rtn_cnts here:" cr
  141.         printall: fcstk
  142.     then
  143.     gpr_rtn_cnt  dup 0<
  144.     IF    drop
  145.         size: cstk  max_gpr_rtn_cnt  min
  146.         dup  -> gpr_rtn_cnt
  147.     THEN
  148.     
  149.     fpr_rtn_cnt  dup 0<
  150.     IF    drop
  151.         size: fcstk  max_fpr_rtn_cnt  min  fpr_call_cnt max
  152.         dup  -> fpr_rtn_cnt
  153.     THEN
  154.     debug? if
  155.         ." get_rtn_cnts returns: " gpr_rtn_cnt .  fpr_rtn_cnt . cr
  156.     then
  157. ;
  158.  
  159.  
  160. \ GET_LOOP_CNTS returns the count of stack cells in regs for the
  161. \  beginning/end of the current loop.  At present we just handle
  162. \  this by calling get_return_cnt, as it may be not worth the extra
  163. \  complexity of having a separate count for each loop.
  164.  
  165. : GET_LOOP_CNTS  ( -- gpr_loop_cnt fpr_loop_cnt )
  166.     get_rtn_cnts  ;
  167.  
  168.  
  169. \ When equalizing on fcstk, it's easiest to just switch fcstk to cstk and
  170. \  fcstk2 to cstk2, do the same calls, then switch them back.
  171.  
  172. : SWITCH_CSTKS
  173.     save: cstk  save: cstk2
  174.     save: fcstk        restore: cstk
  175.     save: fcstk2    restore: cstk2
  176. ;
  177.  
  178. : SWITCH_BACK
  179.     save: cstk        restore: fcstk
  180.     save: cstk2        restore: fcstk2
  181.     restore: cstk2  restore: cstk
  182. ;
  183.  
  184.  
  185. : ALLOCATE_FROM_CSTK2        \ bumps refCnts for regs ref'd from cstk2,
  186.                             \  so that if we need a free reg there won't
  187.                             \  be a conflict.
  188.     size: cstk2  0
  189.     ?DO    i select: cstk2
  190.         allocate: cstk2
  191.     LOOP
  192.     
  193.     size: fcstk2  0
  194.     ?DO    i select: fcstk2
  195.         allocate: fcstk2
  196.     LOOP
  197. ;
  198.  
  199.  
  200. reference thisRef
  201.  
  202. : FIX_DUPS_FOR_1_REF  { cell# 1stTime? \ thisReg newReg any_dups? any_cstk2_matches? -- }
  203.  
  204.     debug? if
  205.         ." fix_dups_for_1_ref - cell# " cell# .
  206.         printall: cstk  printall: cstk2
  207.     then
  208.  
  209.     false -> any_dups?
  210.     cstk ->: thisRef  reg: cstk -> thisReg
  211.     cell# stk: cstk2  cstk =?: cstk2  -> any_cstk2_matches?
  212.  
  213. \ first we do a scan to see if there are any duplicates, and get out if not.
  214. \  We look down the rest of cstk from the current cell#.
  215.  
  216.     size: cstk 1+  cell# 1+
  217.     ?DO    i stk: cstk  i stk: cstk2
  218.         cstk =?: cstk2    or> any_cstk2_matches?
  219.         cstk =?: thisRef  or> any_dups?
  220.     LOOP
  221.     
  222.     debug? if
  223.         ." any dups of this cell? "  any_dups? if ." yes" else ." no" then cr
  224.         ." any cstk2 matches?     "  any_cstk2_matches? if ." yes" else ." no" then cr
  225.     then
  226.  
  227.     any_dups?  0EXIT        \ if no duplicates, there's nothing to do
  228.  
  229. \ now we fix the duplicates by moving any that don't match the corresponding
  230. \  entries in cstk2.  If there weren't any, we'll leave the first alone.
  231.  
  232.     size: cstk 1+  cell#
  233.     any_cstk2_matches? NIF  1+  THEN
  234.     ?DO                    \ again we loop over lower cstk refs, looking for the dups
  235.         i stk: cstk
  236.         cstk =?: thisRef
  237.         IF                            \ here's the next one
  238.             i stk: cstk2            \ does it match the corresponding cstk2 ref?
  239.             cstk =?: cstk2            \  (matching dups are OK, we can leave them)
  240.             
  241.             debug? if
  242.                 dup if ." matches cstk2 cell - can leave it" cr  then
  243.             then
  244.  
  245.             NIF                        \ Nope, we need to fix it.  If the cstk2
  246.                                     \  cell is a free reg, we'll use that, otherwise
  247.                                     \  we find a free one.
  248.                 refType: cstk2  dup  GPRref =  swap FPRref = or
  249.                 IF  reg: cstk2  dup -> newReg  select: eq_regs
  250.                     get: ivar> refCnt in eq_regs
  251.                     NIF        allocate: eq_regs  true
  252.                     ELSE    false
  253.                     THEN
  254.                 ELSE    false
  255.                 THEN
  256.  
  257.                 NIF    getFreeReg: eq_regs  -> newReg  THEN
  258.  
  259.                 debug? if
  260.                     ." fixing duplicn by moving " thisReg .
  261.                     ."  to " newReg .  cr
  262.                 then
  263.  
  264.                 thisReg compile_reg_move: eq_regs
  265.                 thisReg select: eq_regs
  266.                 1stTime? IF  -1 +: ivar> refCnt in eq_regs  THEN
  267.                 newReg >reg: cstk
  268.                 
  269.                 debug? if
  270.                     ." cstk is now:" printall: cstk cr
  271.                 then
  272.  
  273.             THEN
  274.         THEN
  275.     LOOP
  276. ;
  277.  
  278.  
  279. : (FIX_DUPLICATES)  { 1stTime? \ cSiz thisTyp -- }
  280.  
  281.     debug? if
  282.         ." fix_duplicates called - 1stTime? " 1stTime? . cr
  283.         printall: cstk  printall: cstk2
  284.     then
  285.  
  286.     size: cstk -> cSiz
  287.     cSiz 2 <  ?EXIT
  288.     cSiz 1+  1
  289.     DO    i stk: cstk
  290.         refType: cstk -> thisTyp
  291.         thisTyp GPRref =  thisTyp FPRref = or
  292.         IF  i 1stTime? fix_dups_for_1_ref  THEN
  293.     LOOP
  294.     
  295.     debug? if
  296.         ." stacks after (fix_duplicates)" cr
  297.         printall: cstk  printall: cstk2
  298.     then
  299. ;
  300.  
  301.  
  302. : FIX_DUPLICATES  { 1stTime? -- }
  303.  
  304.     GPRs -> eq_regs
  305.     1stTime? (fix_duplicates)
  306.  
  307.     FPRs -> eq_regs  switch_cstks
  308.     debug? if
  309.         ." now doing FPRs:" cr
  310.     then
  311.     1stTime? (fix_duplicates)
  312.     switch_back
  313. ;
  314.  
  315.  
  316. 0    value    CONFLICT_REG
  317.  
  318. : CSTK_CONFLICT?  { stkCell# -- b }
  319.     false
  320.     size: cstk 1+ 1
  321.     ?DO    i stk: cstk
  322.         cstk2 =?: cstk
  323.         IF    i stkCell# <>
  324.             IF  drop true  reg: cstk -> conflict_reg  LEAVE  THEN
  325.         THEN
  326.     LOOP
  327.     stkCell# stk: cstk
  328.     debug? if
  329.         dup    if  ." cstk_conflict? finds conflict for cell " stkCell# . cr
  330.         then
  331.     then
  332. ;
  333.  
  334.  
  335. : CSTK2_CONFLICT?  { stkCell# -- b }
  336.     false
  337.     size: cstk2 1+ 1
  338.     ?DO    i stk: cstk2
  339.         cstk =?: cstk2
  340.         IF  i stkCell# <> IF  drop true  LEAVE  THEN
  341.         THEN
  342.     LOOP
  343.     stkCell# stk: cstk2
  344.     
  345.     debug? if
  346.         dup    if  ." cstk2_conflict? finds conflict for cell " stkCell# . cr
  347.         then
  348.     then
  349. ;
  350.  
  351.  
  352. : FIX_REG_CONFLICT?  { stkCell# 1stTime?
  353.                         \ thisReg newReg useNewReg? -- conflict_handled? }
  354.  
  355.     reg: cstk  -> thisReg  false -> useNewReg?
  356.  
  357.     stkCell# cstk_conflict?        \ does cstk2 GPR conflict on cstk somewhere?
  358.     NIF  false  EXIT  THEN        \ no - nothing for us to do here
  359.  
  360. \ There's a conflict, but we might be able to handle it in the back eq step.
  361.  
  362.     1stTime?
  363.     NIF            \ no back eq step!  We'll have to move the conflicting reg to
  364.                 \  a new reg, then move this reg to the target reg.  Call this
  365.                 \  plan A.
  366.  
  367.         true -> useNewReg?
  368.  
  369.     ELSE        \ There will be a back eq step, but if there would be a
  370.                 \  conflict there too, we'll revert to plan A, which is no
  371.                 \  worse than anything else we might do (such as moving the
  372.                 \  current reg to a new one).
  373.  
  374.         stkCell# cstk2_conflict?  -> useNewReg?
  375.     THEN
  376.     
  377.     useNewReg?
  378.     IF
  379.         getFreeReg: eq_regs  -> newReg
  380.         conflict_reg newReg true moveReg: eq_regs    \ move confilcting reg out
  381.  
  382.         reg: cstk2 select: eq_regs
  383.         reg: cstk  compile_reg_move: eq_regs
  384.                             \ move source to reg which was in conflict before
  385.                             \  - note we can't move by recompiling or we'll
  386.                             \  run right into the conflict!
  387.         debug? if
  388.             ." needed to move conflicting reg " conflict_reg .
  389.             ."  to new reg " newReg .  cr
  390.         then
  391.  
  392.         stkCell# stk: cstk  stkCell# stk: cstk2        \ restore selections
  393.         cstk2 ->: cstk
  394.     ELSE        \ conflict, but OK to leave for back eq step.
  395.         debug? if
  396.             ." OK to leave for back eq step" cr
  397.         then
  398.         stkCell# stk: cstk  stkCell# stk: cstk2        \ restore selections
  399.     THEN
  400.     true                                        \ we've handled the conflict.
  401. ;
  402.  
  403.  
  404. \ ?FIX_XX>GPR_CONFLICT is a bit like FIX_GPR_CONFLICT, but handles the case
  405. \  where the cstk operand is a literal or CR, which is a lot simpler, since
  406. \  we don't have the option of leaving it to the back eq step.  Also
  407. \  we don't return a flag since we don't need it - the op still has to
  408. \  be compiled no matter what happened.  Note that of course this doesn't
  409. \  apply to FPRs.
  410.  
  411. : ?FIX_XX>GPR_CONFLICT  { stkCell# 1stTime? \ newReg -- }
  412.  
  413.     debug? if
  414.         ." ?fix_xx>gpr_conflict - 1stTime? " 1stTime? . cr
  415.     then
  416.  
  417.     stkCell# cstk_conflict?        \ does cstk2 GPR conflict on cstk somewhere?
  418.     0EXIT                        \ no - nothing for us to do here
  419.  
  420. \ There's a conflict.  We do the same as plan A above - move the conflicting reg
  421. \  to a new reg, then compile the lit into the target reg.  We could instead have
  422. \  chosen a new reg for the literal, but on average it would make no difference.
  423.  
  424.     getFreeReg: GPRs  -> newReg
  425.     conflict_reg newReg true moveReg: GPRs        \ move confilcting reg out
  426.  
  427.     stkCell# stk: cstk  stkCell# stk: cstk2        \ restore selections
  428.  
  429.     debug? if
  430.         ." ?fix_xx>gpr_conflict needed to move" cr
  431.         ."  conflicting reg " conflict_reg .
  432.         ."  to new reg " newReg .  cr
  433.         printall: cstk  cr  printall: cstk2  cr
  434.     then
  435. ;
  436.  
  437.  
  438. : CHECK_FOR_PULL
  439.     refType: cstk
  440.     SELECT[    noRef    ]=>
  441.           [    gprRef    ]=>        reg: cstk  >gpr: res1  true
  442.           [    fprRef    ]=>        reg: cstk  >fpr: res1  true
  443.  
  444.           [    litRef    ]=>        lit: cstk  false  lit>gpr
  445.                               false
  446.  
  447.           [    CRref    ]=>        cstk CR>GPR
  448.                               false
  449.           
  450.               DEFAULT=>      refTypeErr
  451.     ]SELECT
  452.  
  453. \ need to check for a reg conflict?
  454.  
  455.     IF    false
  456.         size: cstk2 1+ 1
  457.         ?DO    i stk: cstk2
  458.             cstk =?: cstk2  IF  drop true LEAVE THEN
  459.         LOOP
  460.         IF    getFreeReg: eq_regs  drop
  461.             addr: ivar> myRef in eq_regs  ->: res1
  462.             debug? if
  463.                 ." reg conflict for later pull - using new reg " reg: res1 . cr
  464.             then
  465.             reg: cstk  reg: res1 false moveReg: eq_regs
  466.         THEN
  467.     THEN
  468.  
  469.     res1 ->: cstk
  470. ;
  471.  
  472.  
  473. false    value    pushPull?
  474. false    value    GPR_pushes_or_pulls?
  475. false    value    FPR_pushes_or_pulls?
  476.  
  477. (*    set by equalize_depths, and used by equalize_refs in deciding
  478.     whether to go top-down or bottom-up.  If any cells  are to be
  479.     pushed or pulled, we must go top-down, or cells get mixed up!
  480. *)
  481.  
  482. : (EQUALIZE_DEPTHS)  { 1stTime? \ #toPull n -- }
  483.  
  484. (*    This ensures cstk and cstk2 have the same depth before we get into the
  485.     grubby details of equalization.  We also need to ensure there's at
  486.     least one free register in case we need to copy things around.
  487. *)
  488.  
  489.     debug? if
  490.         ." equalize_depths called - 1stTime? " 1stTime? .  cr
  491.         printall: cstk  printall: cstk2  cr
  492.     then
  493.  
  494.     false -> pushPull?
  495.         
  496.     size: cstk2  size: cstk  -  -> #toPull
  497.     #toPull  0EXIT
  498.  
  499.     true -> pushPull?
  500.  
  501.     #toPull 0>
  502.     IF            \ cstk2 is deeper.  Pull cells into cstk to match.
  503.         size: cstk 1+ -> n
  504.         #toPull
  505.         FOR        n stk: cstk2        
  506.                 moveDown: cstk    \ leaves element 0 selected - the one we're
  507.                                 \  going to pull to
  508.                 >pull: cstk
  509.                 1 ++> n
  510.         NEXT
  511.     ELSE        \ cstk is deeper.  Now we can't pull into cstk2 here.  If
  512.                 \ 1stTime? is true, we can arrange to do it in the back
  513.                 \ equalization step, and here we just need to ensure the
  514.                 \ cstk cell types are appropriate.
  515.                 \ But if 1stTime? is false, we'll have to push off the
  516.                 \ excess cstk cells into memory here.
  517.                 
  518.         neg> #toPull
  519.         1stTime?
  520.         IF    
  521.             debug? if
  522.                 ." will be pulling " #toPull . ."  regs on back eq step" cr
  523.             then
  524.             
  525.             size: cstk2 1+ -> n
  526.             #toPull
  527.             FOR        n stk: cstk
  528.                     check_for_pull
  529.                     1 ++> n
  530.             NEXT
  531.         ELSE
  532.             #toPull            \ really # to push
  533.             FOR  push&moveUp  NEXT
  534.         THEN
  535.     THEN
  536.  
  537.     debug? if    ." stacks after equalize_depths" cr
  538.                 printall: cstk  printall: cstk2  cr
  539.     then
  540. ;
  541.  
  542.  
  543. : EQUALIZE_DEPTHS  { 1stTime? -- }
  544.     GPRs -> eq_regs
  545.     1stTime? (equalize_depths)
  546.     pushPull? -> GPR_pushes_or_pulls?
  547.  
  548.     FPRs -> eq_regs  switch_cstks
  549.     debug? if
  550.         ." now doing FPRs:" cr
  551.     then
  552.     1stTime? (equalize_depths)
  553.     pushPull? -> FPR_pushes_or_pulls?
  554.     switch_back
  555. ;
  556.  
  557.  
  558. : HANDLE_SPECIAL_REGS?  { stkCell# -- handled? }
  559.  
  560. (* we call this word if we have a reg-reg equalization, on the first pass if
  561.    there's going to be a back equalization.  In this situation we mustn't
  562.    overwrite  a special register, so this word checks if one or both regs
  563.    are special.  We handle this case in a similar way to one or both
  564.    operands being literal.  If we handle it, we return true.
  565. *)
  566.     reg: cstk  select: eq_regs
  567.     get: ivar> special? in eq_regs
  568.     IF    reg: cstk2  select: eq_regs
  569.         get: ivar> special? in eq_regs
  570.         IF                            \ both regs are special
  571.                                     \ - we allocate a new free reg
  572.             debug? if
  573.                 ." both regs are special - using a new one" cr
  574.             then
  575.  
  576.             reg: cstk
  577.             getFreeReg: eq_regs        \ leave reg# for moveReg: below
  578.             addr: ivar> myRef in eq_regs  ->: cstk
  579.             true moveReg: eq_regs  true  EXIT
  580.         THEN
  581.                                     \ cstk reg is special - we can
  582.                                     \  move to the cstk2 reg, unless
  583.                                     \  there's a conflict
  584.         debug? if
  585.             ." cstk reg is special - want to move "
  586.             print: cstk ."  to " print: cstk2  cr
  587.         then
  588.  
  589.         stkCell# cstk_conflict?
  590.         IF                \ there's a conflict
  591.             getFreeReg: eq_regs  drop  addr: ivar> myRef in eq_regs  ->: res1
  592.             debug? if
  593.                 ." but there's a reg conflict - changing to reg " reg: res1 . cr
  594.             then
  595.             stkCell# stk: cstk        \ in case it changed
  596.             reg: cstk  reg: res1 true moveReg: eq_regs
  597.             res1 ->: cstk  true  EXIT
  598.         THEN
  599.  
  600.         reg: cstk  reg: cstk2 true moveReg: eq_regs  true  EXIT
  601.     THEN
  602.     
  603.     reg: cstk2  select: eq_regs
  604.     get: ivar> special? in eq_regs
  605.     NIF        \ neither is special
  606.         false  EXIT
  607.     THEN
  608.  
  609. \ only the cstk2 reg is special.  If there's no cstk2 conflict on the
  610. \  cstk reg, we can leave it for the back eq step (there definitely should
  611. \  be one!).  Otherwise we'll have to use a new reg.
  612.  
  613.     debug? if
  614.         ." cstk2 reg is special" cr
  615.     then
  616.  
  617.     stkCell# cstk2_conflict?  NIF  true  EXIT  THEN
  618.     
  619.     debug? if
  620.         ." conflict means we have to use a new reg" cr
  621.     then
  622.     
  623.     reg: cstk
  624.     getFreeReg: eq_regs        \ leave reg# for moveReg: below
  625.     addr: ivar> myRef in eq_regs  ->: cstk
  626.     true moveReg: eq_regs
  627.     true
  628. ;
  629.  
  630.  
  631. : EQUALIZE_GPR>GPR  { stkCell# 1stTime? \ mustMove? -- }
  632.     false -> mustMove?
  633.     debug? if
  634.         ." equalize_gpr>gpr - 1stTime? " 1stTime? . cr
  635.     then
  636.  
  637.     1stTime?
  638.     IF    stkCell# handle_special_regs?  ?EXIT
  639.                                     \ if reg(s) special, handle and out
  640.         stkCell# 1stTime? fix_reg_conflict?  ?EXIT
  641.                                     \ out if it's been handled
  642.  
  643. \ now if we're moving to a lower reg number, we'll move it now
  644. \  - hopefully to migrate regs down, and reduce moves when we do a call, or
  645. \  at semicolon time.
  646.  
  647.         gpr: cstk  gpr: cstk2  > IF  true -> mustMove?  THEN
  648.  
  649.     ELSE
  650.         true -> mustMove?
  651.     THEN
  652.                     
  653.     mustMove?
  654.     NIF        \ see if we can move by recompiling, or put it off in the hope
  655.             \  that we can recompile in the back eq step.
  656.                     
  657.         gpr: cstk  gpr: cstk2
  658.         moveReg_by_recompiling?: GPRs  ?EXIT        \ success!
  659.         stkCell# cstk2_conflict?  -> mustMove?
  660.     THEN
  661.  
  662.     debug? if
  663.         mustMove?    if ." moving now"
  664.                     else ." leaving for back eq step"
  665.                     then  cr
  666.     then
  667.  
  668.     mustMove?
  669.     IF    stkCell# 1stTime? fix_reg_conflict?  ?EXIT
  670.         gpr: cstk  gpr: cstk2  false  moveReg: GPRs
  671.                             \ note we don't update refs here - at this
  672.                             \  stage we've finalized the identities of
  673.                             \  the regs we want to move and don't want
  674.                             \  to alter them!
  675.         cstk2 ->: cstk
  676.     THEN
  677. ;
  678.  
  679. : (PULL)  { stkCell#  -- }
  680.     stkCell# stk: cstk
  681.     res1 ->: cstk
  682.     refType: res1  GPRref =
  683.     IF    gpr: res1  select: GPRs  SP_reg stk_offset 0 compPull: GPRs
  684.         1cell ++> stk_offset
  685.     ELSE
  686.         fpr: res1  select: FPRs  FSP_reg  fstk_offset 0 compPull: FPRs
  687.         8 ++> fstk_offset
  688.     THEN
  689. ;
  690.  
  691. : EQUALIZE_PULL>GPR  { stkCell# -- }
  692.     gpr: cstk2  >gpr: res1
  693.     stkCell# cstk_conflict?
  694.     IF                \ there's a conflict
  695.         getFreeReg: GPRs  >gpr: res1
  696.         debug? if
  697.             ." reg conflict for pull - changing to gpr " reg: res1 . cr
  698.         then
  699.     THEN
  700.     stkCell# (pull)
  701. ;
  702.  
  703. : PULL>NEW_GPR  { stkCell# -- }
  704.     getFreeReg: GPRs  >gpr: res1
  705.     debug? if
  706.         ." pull>new_gpr will use gpr " reg: res1 . cr
  707.     then
  708.  
  709.     stkCell# (pull)
  710. ;
  711.  
  712.  
  713. : EQUALIZE_LIT>GPR  { stkCell# 1stTime? \ mustMove? xx -- }
  714.     debug? if
  715.         ." equalize_lit>gpr - 1stTime? " 1stTime? . cr
  716.     then
  717.  
  718.     1stTime?
  719.     IF            \ mustn't clobber a special reg
  720.         gpr: cstk2  select: GPRs
  721.         get: ivar> special? in GPRs
  722.         IF            \ cstk2 reg is special - we have to allocate a new one
  723.             [ debug? ] [if]
  724.                 ." lit -> special reg - using a new one" cr
  725.             [then]
  726.             lit: cstk  false  lit>gpr
  727.             res1 ->: cstk  EXIT
  728.         THEN
  729.     THEN
  730.     
  731. \ OK to use cstk2 reg now
  732.  
  733.     stkCell# 1stTime? ?fix_xx>gpr_conflict
  734.     gpr: cstk2  select: GPRs
  735.  
  736.     otFetch        put: ivar> opType    in GPRs
  737.               clear: ivar> A_opnd    in GPRs
  738.     lit: cstk  >lit: ivar> B_opnd    in GPRs
  739.  
  740.     compile: GPRs
  741.     current: GPRs  >gpr: cstk
  742. ;
  743.  
  744.  
  745. : EQUALIZE_CR>GPR  { stkCell# 1stTime? \ mustMove? -- }
  746.     1stTime?
  747.     IF                \ mustn't clobber a special reg
  748.         gpr: cstk2  select: GPRs
  749.         get: ivar> special? in GPRs
  750.         IF            \ cstk2 reg is special - we have to allocate a new one
  751.             debug? if
  752.                 ." CR -> special reg - using a new one" cr
  753.             then
  754.  
  755.             cstk  CR>GPR
  756.             free: cstk  res1 ->: cstk  EXIT
  757.         THEN
  758.     THEN
  759.     
  760. \ OK to use cstk2 reg now
  761.  
  762.     stkCell# 1stTime? ?fix_xx>gpr_conflict
  763.     cstk  gpr: cstk2  cr>this_gpr    \ also frees the CR ref
  764.     cstk2 ->: cstk
  765. ;
  766.  
  767. : EQUALIZE_FPR>FPR  { stkCell# 1stTime? \ mustMove? -- }
  768.     false -> mustMove?
  769.     debug? if
  770.         ." equalize_fpr>fpr - 1stTime? " 1stTime? . cr
  771.     then
  772.  
  773.     1stTime?
  774.     IF    stkCell# handle_special_regs?  ?EXIT
  775.                                     \ if reg(s) special, handle and out
  776.         stkCell# 1stTime? fix_reg_conflict?  ?EXIT
  777.                                     \ out if it's been handled
  778.  
  779. \ now if we're moving to a lower reg number, we'll move it now
  780. \  - hopefully to migrate regs down, and reduce moves when we do a call, or
  781. \  at semicolon time.
  782.  
  783.         fpr: cstk  fpr: cstk2  > IF  true -> mustMove?  THEN
  784.  
  785.     ELSE
  786.         true -> mustMove?
  787.     THEN
  788.                     
  789.     mustMove?
  790.     NIF        \ see if we can move by recompiling, or put it off in the hope
  791.             \  that we can recompile in the back eq step.
  792.                     
  793.         fpr: cstk  fpr: cstk2
  794.         moveReg_by_recompiling?: FPRs  ?EXIT        \ success!
  795.         stkCell# cstk2_conflict?  -> mustMove?
  796.     THEN
  797.  
  798.     debug? if
  799.         mustMove?    if ." moving now"
  800.                     else ." leaving for back eq step"
  801.                     then  cr
  802.     then
  803.  
  804.     mustMove?
  805.     IF    stkCell# 1stTime? fix_reg_conflict?  ?EXIT
  806.         fpr: cstk  fpr: cstk2  false  moveReg: FPRs
  807.                             \ note we don't update refs here - at this
  808.                             \  stage we've finalized the identities of
  809.                             \  the regs we want to move and don't want
  810.                             \  to alter them!
  811.         cstk2 ->: cstk
  812.     THEN
  813. ;
  814.  
  815.  
  816. : EQUALIZE_PULL>FPR  { stkCell# -- }
  817.     fpr: cstk2  >fpr: res1
  818.     stkCell# cstk_conflict?
  819.     IF                \ there's a conflict
  820.         getFreeReg: FPRs  >fpr: res1
  821.         debug? if
  822.             ." reg conflict for pull - changing to fpr " reg: res1 . cr
  823.         then
  824.     THEN
  825.     stkCell# (pull)
  826. ;
  827.  
  828. : PULL>NEW_FPR  { stkCell# -- }
  829.     getFreeReg: FPRs  >fpr: res1
  830.     debug? if
  831.         ." pull>new_fpr will use fpr " reg: res1 . cr
  832.     then
  833.  
  834.     stkCell# (pull)
  835. ;
  836.  
  837.  
  838. : AVOID_SPECIAL_GPR  { \ newReg -- }
  839.     gpr: cstk  select: GPRs
  840.     get: ivar> special? in GPRs
  841.     IF
  842.         getFreeReg: GPRs  -> newReg
  843.         [ debug? ] [if]
  844.             ." cstk gpr is special - moving to a free one: "  newReg .  cr
  845.         [then]
  846.         reg: cstk  newReg  false  moveReg: GPRs
  847.         newReg >gpr: cstk
  848.     THEN
  849. ;
  850.  
  851.  
  852. : EQUALIZE_1_REF_PAIR { stkCell# 1stTime? \ litVal -- }
  853.  
  854.     debug? if
  855.         ." equalize_1_ref_pair" cr print: cstk  print: cstk2  cr
  856.         [ ppc? ] [if] dbgr [then]
  857.     then
  858.  
  859.     cstk =?: cstk2  ?EXIT        \ if already equal, nothing to do
  860.  
  861. \ now we just enumerate all the combinations.  This is a bit long-winded,
  862. \  but each combination is simple enough.
  863.  
  864.     refType: cstk2
  865.     
  866.     SELECT[    noRef    ]=>        \ we assume this is going to be handled on the back eq step
  867.  
  868.           [    gprRef    ]=>
  869.  
  870.                 refType: cstk
  871.                 SELECT[    gprRef    ]=>
  872.                             stkCell# 1stTime? equalize_gpr>gpr
  873.  
  874.                       [    litRef    ]=>
  875.                             stkCell# 1stTime? equalize_lit>gpr
  876.  
  877.                          [    fprRef    ]=>        FPerr
  878.  
  879.                         [    CRref    ]=>        \ cstk cstk2  CR>GPR
  880.                                             stkCell# 1stTime?  equalize_cr>gpr
  881.                                             \ cstk2 ->: cstk
  882.                     
  883.                         [    pullRef    ]=>        stkCell# equalize_pull>gpr
  884.  
  885.                         DEFAULT=>          refTypeErr
  886.                 ]SELECT
  887.  
  888.  
  889.           [    fprRef    ]=>
  890.  
  891.                   refType: cstk
  892.                 SELECT[    fprRef    ]=>        stkCell# 1stTime?  equalize_fpr>fpr
  893.                         [    pullRef    ]=>        stkCell# equalize_pull>fpr
  894.  
  895.                       DEFAULT=>  fpErr
  896.                 ]SELECT
  897.  
  898.           [    crRef    ]=>
  899.  
  900.                   refType: cstk
  901.                 SELECT[    gprRef    ]=>    1stTime?
  902.                                     IF        \ we'll handle in back eq step
  903.                                             \  - we just have to check the
  904.                                             \  gpr is OK to clobber.
  905.                                         avoid_special_gpr
  906.                                     ELSE    db $ 999 $ deadbeef
  907.                                     THEN
  908.                 
  909.                       [    litRef    ]=>        \ we get the lit to a GPR, then back eq
  910.                                           \  will fix
  911.                                       lit: cstk  false  lit>gpr
  912.                                     res1 ->: cstk
  913.                 
  914.                          [    fprRef    ]=>        FPerr
  915.  
  916.                         [    CRref    ]=>        \ we have to do a CR->CR move here.
  917.                                         cstk cstk2  move_CR_bit
  918.                                         cstk2 ->: cstk
  919.                     
  920.                         [    pullRef    ]=>        stkCell# pull>new_gpr
  921.  
  922.                       DEFAULT=>      refTypeErr
  923.                 ]SELECT
  924.  
  925.           [    litRef    ]=>
  926.  
  927.                 refType: cstk
  928.                 
  929.                 SELECT[    gprRef    ]=>        avoid_special_gpr
  930.  
  931.                       [    litRef    ]=>    lit: cstk  lit: cstk2  <>
  932.                               IF    \ we only need to do anything if they're
  933.                                   \  different, in which case we have to
  934.                                   \  load into a gpr.  lit>gpr looks after this.
  935.                                   
  936.                                   lit: cstk  false  lit>gpr
  937.                                 res1 ->: cstk
  938.                               THEN
  939.                                       
  940.                       [    fprRef    ]=>        FPerr
  941.  
  942.                       [    CRref    ]=>
  943.                                 cstk  cr>gpr
  944.                                 res1 ->: cstk
  945.  
  946.                         [    pullRef    ]=>
  947.                                 stkCell# pull>new_gpr
  948.  
  949.                       DEFAULT=>  refTypeErr
  950.                 ]SELECT
  951.  
  952.           DEFAULT=>  refTypeErr
  953.     ]SELECT
  954. ;
  955.  
  956.  
  957. : (EQUALIZE_REFS)  { pushes/pulls? 1stTime? \ #cells n bottom_up? -- }
  958.     debug? if
  959.         ." equalize_refs called:" cr
  960.         printall: cstk  printall: cstk2  cr
  961.     then
  962.  
  963.     false -> bottom_up?
  964.     size: cstk  -> #cells
  965.     #cells
  966.     IF
  967. \ if we're going to be moving regs downwards, it's more
  968. \ advantageous to start at the bottom and go up - but if we're
  969. \ doing any pushes or pulls, we have to go top-down no matter what.
  970.  
  971.         pushes/pulls?
  972.         NIF    #cells 2 >=
  973.             IF    1 stk: cstk  1 stk: cstk2
  974.                 refType: cstk  gprRef =
  975.                 refType: cstk2 gprRef = and
  976.                 IF    reg: cstk  reg: cstk2 >  -> bottom_up?
  977.                 THEN
  978.             THEN
  979.         THEN
  980.     
  981.         debug? if
  982.             ." bottom_up? " bottom_up? if ." true" else ." false" then cr
  983.         then
  984.  
  985.         bottom_up?
  986.         IF #cells ELSE 1 THEN -> n
  987.     
  988.         #cells
  989.         FOR    n stk: cstk  n stk: cstk2
  990.             n 1stTime? equalize_1_ref_pair
  991.             bottom_up? IF 1 --> n ELSE 1 ++> n THEN
  992.         NEXT
  993.     THEN
  994.  
  995.     debug? if
  996.         ." stacks after equalize_refs" cr
  997.         printall: cstk  printall: cstk2
  998.     then
  999. ;
  1000.  
  1001.  
  1002. : EQUALIZE_REFS  { 1stTime? -- }
  1003.     GPRs -> eq_regs
  1004.     GPR_pushes_or_pulls? 1stTime? (equalize_refs)
  1005.  
  1006.     FPRs -> eq_regs  switch_cstks
  1007.     debug? if
  1008.         ." now doing FPRs:" cr
  1009.     then
  1010.     FPR_pushes_or_pulls? 1stTime? (equalize_refs)
  1011.     switch_back
  1012. ;
  1013.  
  1014.  
  1015. : EQUALIZE_FOR_CONDITIONAL  { branchCDP \ locBrCDP destCDP -- }
  1016.  
  1017.     CDP +L: eq_ranges
  1018.     true -> equalizing?
  1019.     GPRs -> eq_regs
  1020.     adjust_stks                            \ it's probably been called already, but 
  1021.                                         \  this won't hurt
  1022.     branchCDP 4+ -> basic_block_start    \ BB starts straight after the branch
  1023.  
  1024. \ ." now in equalize_for_conditional" cr .s dbgr
  1025.     restore: fcstk2  restore: cstk2        \ get saved cstk and fcstk to cstk2 & fcstk2
  1026. \ .s
  1027.     save: cstk2  save: fcstk2            \ and copy to cstk2_orig and fcstk2_orig
  1028.     restore: fcstk2_orig  restore: cstk2_orig        \ in case
  1029.                                         \ cstk2/fcstk2 get changed - although I
  1030.                                         \  think they probably shouldn't
  1031.     debug? if
  1032.         ." equalize_for_conditional called:" cr
  1033.         printall: cstk  printall: cstk2  printall: fcstk printall: fcstk2
  1034.     then
  1035.  
  1036.     allocate_from_cstk2
  1037.     true fix_duplicates
  1038.     true equalize_depths
  1039.     true equalize_refs
  1040.     adjust_stks
  1041.  
  1042. \ now we compile a branch over the back equalization code we're about to
  1043. \  generate:
  1044.  
  1045.     CDP -> locBrCDP
  1046.     compile_unconditional_branch
  1047.     save: cstk  restore: cstk2
  1048.     save: cstk2_orig  restore: cstk
  1049.     save: fcstk  restore: fcstk2
  1050.     save: fcstk2_orig  restore: fcstk
  1051.  
  1052.     debug? if ." stacks before back equalizing:" cr
  1053.         printall: cstk  printall: cstk2  printall: fcstk printall: fcstk2
  1054.     then
  1055.     
  1056.     true -> eq_block_recompiling_move?    \ mustn't monkey with reg moves during
  1057.                                         \  back equalization!
  1058.     false fix_duplicates
  1059.     false equalize_depths
  1060.     false equalize_refs
  1061.     adjust_stks
  1062.  
  1063. \ now, did we actually compile anything in the back equalization?
  1064.  
  1065.     CDP 4-  locBrCDP =
  1066.     IF                    \ no - wipe out the uncond branch altogether, and
  1067.         [ debug? ] [if]
  1068.             ." nothing compiled in back eq - deleting the branch"  cr
  1069.         [then]
  1070.         4 --> CDP
  1071.         CDP                \ present posn is dest of main branch
  1072.  
  1073.     ELSE                \ yes - resolve the uncond branch over the
  1074.                         \  back eq code
  1075.         debug? if
  1076.             ." compiled some code in back eq step"  cr
  1077.         then
  1078.  
  1079.         locBrCDP CDP  resolve_branch
  1080.         locBrCDP 4+        \ back eq code start is dest of main branch
  1081.     THEN
  1082.     -> destCDP
  1083.  
  1084. \ now we resolve the main branch, to the dest we worked out above:
  1085.  
  1086.     branchCDP destCDP  resolve_branch
  1087.     update_refcnts
  1088.  
  1089.     debug? if
  1090.         ." end of equalize_for_conditional - final stacks (should be the same):" cr
  1091.         printall: cstk  printall: cstk2
  1092.     then
  1093.     
  1094.     false -> eq_block_recompiling_move?
  1095.     CDP +L: eq_ranges
  1096.     false -> equalizing?
  1097. ;
  1098.  
  1099.  
  1100. \        =========================================================
  1101. \                            SIMPLE_EQUALIZE        
  1102. \        =========================================================
  1103.  
  1104. : SIMPLE_EQUALIZE  { gpr_cnt fpr_cnt -- }
  1105.  
  1106.     true -> equalizing?
  1107.     GPRs -> eq_regs
  1108.  
  1109.     debug? if
  1110.         ." simple_equalize called - cstk:" cr  printall: cstk
  1111.         ." gpr_cnt:" gpr_cnt . cr
  1112.         ." fpr_cnt:" fpr_cnt . cr
  1113.         ." CDP:" CDP .h cr
  1114.     then
  1115.  
  1116.     fpr_cnt -1 = IF  fpr_call_cnt -> fpr_cnt  THEN        \ -1 means use the default
  1117.  
  1118.     gpr_cnt  fpr_cnt  setup_normal_call
  1119.     
  1120.     debug? if
  1121.         ." stacks set up for equalization:" cr
  1122.         printall: cstk  printall: cstk2
  1123.     then
  1124.  
  1125.     false fix_duplicates
  1126.     false equalize_depths
  1127.     false equalize_refs
  1128.     update_refcnts
  1129.     adjust_stks? IF  adjust_stks  ELSE  true -> adjust_stks?  THEN
  1130.  
  1131.     debug? if
  1132.         ." final stacks - should be the same:" cr
  1133.         printall: cstk  printall: cstk2
  1134.     then
  1135.  
  1136.     set_backstop_CDP            \ the places where we use simple_equalize
  1137.                                 \  all require something this
  1138.     false -> equalizing?
  1139.  
  1140. ;
  1141.  
  1142.  
  1143.  
  1144. \        =========================================================
  1145. \                            LOOP EQUALIZATION        
  1146. \        =========================================================
  1147.  
  1148. \ PREPARE_FOR_LOOP is called from <mark when we're setting up a loop.
  1149.  
  1150. : PREPARE_FOR_LOOP
  1151.  
  1152.     debug? if
  1153.         ." prepare_for_loop called - calling equalize_for_call to set up:" cr
  1154.     then
  1155.  
  1156. (*    We could define a separate "loop count" for each loop - the number of
  1157.     cells in regs that we're going to equalize to.  But this might be
  1158.     overkill, and certainly would complicate LEAVE (which would have to
  1159.     keep track of the appropriate count for the innermost containing
  1160.     DO loop, not the innermost containing loop).  So at present we'll
  1161.     just use the rtn_cnt mechanism, which is simple, and probably
  1162.     nearly as good anyway (especially if definitions are short, in which case
  1163.     we probably won't have done an EXIT yet, so return_cnt will be set
  1164.     to whatever the depth is here at the loop start).
  1165. *)
  1166.     get_rtn_cnts  simple_equalize
  1167.  
  1168.     adjust_stks
  1169.     CDP -> basic_block_start  CDP -> loop_start
  1170. ;
  1171.  
  1172.  
  1173. : UPDATE_STORES
  1174.     31 0
  1175.     DO    i select: stored_GPRs
  1176.         get: ivar> opType in stored_GPRs  otStore =
  1177.         IF    i select: GPRs
  1178.             get: ivar> opCDP        in GPRs
  1179.             put: ivar> lastRefCDP    in stored_GPRs
  1180.         THEN
  1181.     LOOP
  1182.     
  1183.     31 0
  1184.     DO    i select: stored_FPRs
  1185. \        get: ivar> opType in stored_GPRs  otFPstore =        \ a BUG, surely!
  1186.         get: ivar> opType in stored_FPRs  otFPstore =
  1187.         IF    i select: FPRs
  1188.             get: ivar> opCDP        in FPRs
  1189.             put: ivar> lastRefCDP    in stored_FPRs
  1190.         THEN
  1191.     LOOP
  1192. ;
  1193.  
  1194.  
  1195. : HOIST_INVARIANTS
  1196.     debug? if
  1197.         ." hoisting invariants to before loop" cr
  1198.     then
  1199.  
  1200.     hoist? 0EXIT            \ bail out if we've disabled hoisting
  1201.  
  1202.     ?hoist_all: GPRs
  1203.     ?hoist_all: FPRs
  1204.     update_stores
  1205.     debug? if
  1206.         ." hoisting stored_GPRs" cr
  1207.         printall: stored_GPRs
  1208.     then
  1209.     ?hoist_all: stored_GPRs
  1210. \    ?hoist_all: CRs        \ very dubious about this!  Note if we ever do
  1211.                         \  it we must exclude CR0 since that's set as a
  1212.                         \  side effect, and all its OD fields won't
  1213.                         \  be set up!
  1214. ;
  1215.  
  1216.  
  1217. : EQUALIZE_FOR_LOOP  { markCDP -- }
  1218.  
  1219.     debug? if
  1220.         ." equalize_for_loop called:" cr
  1221.         printall: cstk  printall: cstk2  printall: fcstk printall: fcstk2
  1222.     then
  1223.     
  1224.     true -> equalizing?
  1225.     GPRs -> eq_regs
  1226.     adjust_stks
  1227.     markCDP -> basic_block_start    \ prepare_for_loop should have already
  1228.                                     \  done this, but let's be sure.
  1229.  
  1230.     restore: fcstk2  restore: cstk2
  1231.     
  1232.     allocate_from_cstk2
  1233.  
  1234.     false fix_duplicates
  1235.     false equalize_depths
  1236.     false equalize_refs
  1237.     update_refcnts
  1238.     adjust_stks
  1239.  
  1240.     debug? if ." final stacks - should be the same:" cr
  1241.         printall: cstk  printall: cstk2
  1242.     then
  1243.     false -> equalizing?
  1244. ;
  1245.  
  1246.  
  1247. \        =========================================================
  1248. \             CALL EQUALIZATION, including PROLOG and EPILOG        
  1249. \        =========================================================
  1250.  
  1251.  
  1252.     0    value    svFramesize
  1253.     0    value    sv#gprs
  1254.     0    value    sv#fprs
  1255.  
  1256. \    0    value    savedRegs
  1257. false    value    dont_save_r20?
  1258.     0    value    #xs_parms
  1259.     0    value    frame_offs
  1260.  
  1261.  
  1262. \ SP_reg 16 <<        \ can't do compile-time ops when target compiling
  1263. $ 120000        constant  SP<<16
  1264. \ RP_reg 16 <<
  1265. $ 110000        constant  RP<<16
  1266.  
  1267.  
  1268. \ These words are factored out of compile_prolog and compile_epilog 
  1269. \  basically to shorten the former, which is quite long enough already.
  1270. \  These defns are only called from there.
  1271.  
  1272. : move_regs  { #regs instrn decrement \ reg# -- }
  1273.     #regs  0EXIT
  1274.     31 -> reg#
  1275.     #regs
  1276.     FOR                                \ for each reg to be saved:
  1277.         decrement ++> frame_offs
  1278.         instrn  RP<<16 or  frame_offs or
  1279.         reg# 21 << or  code,        \  stw  reg, n(RP)
  1280.         -1 ++> reg#
  1281.     NEXT
  1282. ;
  1283.  
  1284. ppc?
  1285. [if]
  1286.  
  1287. : move_vrs  { instrn -- }
  1288.     #VL  0EXIT
  1289.     $ 39800000  RP<<16 or
  1290.     frame_offs 16 - or
  1291.     code,                                    \  addi r12, RP, offset
  1292.     #VL FOR
  1293.         instrn ( $ 7C0061CE ) 31 i - 21 << or code,    \ stvx  vn, 0, r12
  1294.         i IF
  1295.             $ 3980FFF0 12 16 << or code,    \ addi r12, r12, -16
  1296.         THEN
  1297.         -16 ++> frame_offs
  1298.     NEXT
  1299. ;
  1300.  
  1301. [then]
  1302.  
  1303.  
  1304. objPtr parmsRegs  class_is ODs_class
  1305.  
  1306. : move_parms  { #parms call_cnt decrement stk_offs stk_reg gprs? 
  1307.                 \ srcReg# dstReg# #parms2move n -- }
  1308.  
  1309.     #parms  0EXIT
  1310.  
  1311.     31 -> dstReg#
  1312.     
  1313. \ if it's a forward defn, we may have to pull some parms from memory, since
  1314. \  only call_cnt cells are in regs.
  1315.  
  1316.     forward?
  1317.     IF    #parms call_cnt >
  1318.         IF    #parms call_cnt -  -> n            \ number to pull
  1319.             n decrement *  ++> stk_offs
  1320.             stk_offs                        \ save for adjustment
  1321.             n FOR
  1322.                 dstReg# select: parmsRegs
  1323.                 decrement --> stk_offs
  1324.                 stk_reg stk_offs 0  compPull: parmsRegs
  1325.                 -1  ++> dstReg#
  1326.             NEXT
  1327.             gprs? IF  -> stk_offset  ELSE  -> fstk_offset  THEN
  1328.             adjust_stks
  1329.             call_cnt        \ the number for the reg -> reg moves below
  1330.         ELSE
  1331.             #parms
  1332.         THEN
  1333.     ELSE
  1334.         #parms
  1335.     THEN
  1336.     -> #parms2move
  1337.  
  1338. (*    Now we initialize srcReg# to the first reg we move.  Our current
  1339.     policy is that we don't want the number of regs in use to get
  1340.     too low, which would increase the number of mem fetches.  So if
  1341.     the number of parms is less than a minimum (given by call_cnt)
  1342.     we make up the number with cached stack cells.  So with call_cnt
  1343.     currently 2, this means that if there's only one named integer
  1344.     parm, we pass it in r4, not r3, and leave the next stack cell in 
  1345.     r3.  But if this is a callback or a shared library entry, we 
  1346.     mustn't do this, but simply start the parms in r3/f1.
  1347. *)
  1348.     entry?
  1349.     IF        0
  1350.     ELSE    call_cnt #parms2move -  0 max
  1351.     THEN
  1352.     gprs? if 3 else 1 then +  -> srcReg#
  1353.     #parms2move
  1354.     FOR    srcReg# dstReg# true moveReg: parmsRegs
  1355.         1 ++> srcReg#  -1 ++> dstReg#
  1356.     NEXT
  1357. ;
  1358.  
  1359.  
  1360. (*    We call COMPILE_PROLOG to compile a prolog at the start of a definition.
  1361.  
  1362.     Our prologs are a bit different to the standard PPC convention,
  1363.     although they do much the same things.
  1364.    
  1365. 1.    We use the return stack for a frame since we have to leave the data
  1366.     stack untouched.
  1367.    
  1368. 2.    We don't use the standard linkage area format since we don't need to.
  1369.     In particular we save the link register in the newly created frame
  1370.     rather than the caller's frame (which mightn't be pointed to on entry
  1371.     by RP anyway, since the caller might have done >R or something first).
  1372.     This also means that we can load the LR as early as possible in the
  1373.     return sequence, so that maybe the blr won't stall.
  1374.  
  1375.  
  1376.     The frame format is (going left to right, or UP in memory):
  1377.  
  1378.     saved LR | saved r20 | temp object block | saved gprs | saved fprs |
  1379.     
  1380.     The saved LR is omitted for leaf calls, and r20 (the obj base reg) is
  1381.     only saved for method calls.  Also we only allocate a temp object block
  1382.     if we need to.  These items are simply omitted from the frame if not 
  1383.     used - they're not left empty; they're completely omitted.
  1384.     This gives us a chance of not having a frame at all if we don't
  1385.     need it.
  1386.  
  1387.     If we have temp objects, we always need a frame, so in this case
  1388.     we simplify things a bit by leaving a fixed space of 16 bytes above 
  1389.     RP before the temp object block starts.  This preserves alignment 
  1390.     on the temp obj block, and is enough space whatever else we're doing 
  1391.     in the frame.  It even works when there are vectors (see below).
  1392.  
  1393.     So we know the size of the temp obj block, zClass leaves the size 
  1394.     in tempObj_block_size.  This is the sum of the sizes of the temp
  1395.     objects and their headers.  (The temp objects are treated by zClass
  1396.     as ivars of class Dummy, but there's no "object header" for Dummy
  1397.     itself since it isn't a real class and its info isn't even around
  1398.     when the temp objects are initialized.)
  1399.  
  1400.     Also note we have to make sure any FPRs we copy to/from the frame are
  1401.     8-byte aligned.  To ensure this, we always 8-byte align RP, and save
  1402.     the FPRs rightmost.  Also the temp object block is 8-byte aligned
  1403.     (since it starts 16 bytes from RP), so our ivar alignment scheme will
  1404.     guarantee that any Float temp objects will be aligned.
  1405.     
  1406.  
  1407.     Vectors complicate things.  They have to be 16-byte aligned.  So if
  1408.     there are vectors, either in the temp object block or needing to be
  1409.     saved/restored, we use a different frame format, which is 16-byte
  1410.     aligned even though the RP is only guaranteed to be 8-byte aligned
  1411.     before the frame is set up.  This "xaligned" (extra aligned) format
  1412.     takes a few extra instructions to set up, so we only use it if we
  1413.     have to.  We can also use it in future if any other PowerPC extensions
  1414.     turn out to need alignment greater than 8-byte.
  1415.     
  1416.     Here's the xaligned frame format:
  1417.     
  1418.     saved RP | saved LR | saved r20 | spare | temp object frame |
  1419.             saved gprs | saved fprs | saved vrs |
  1420.  
  1421.     Note the temp object block comes in its usual place, 16 bytes above RP, but 
  1422.     is now 16-byte aligned since RP is.  Also note that since we make sure
  1423.     the saved vrs are 16-byte aligned, the saved fprs are guaranteed to be 
  1424.     8-byte aligned as required.
  1425.  
  1426.  
  1427.     
  1428.     COMPILE_PROLOG compiles code which allocates the frame on the return stack,
  1429.     saves LR and the other relevant regs, then moves the top stack cells to the
  1430.     named parm regs.
  1431.     
  1432.     On entry CDP points to the beginning of the defn.
  1433.     
  1434.     Leaf procs are a special case - not only don't we save LR, we do the prolog
  1435.     work in the caller, not the callee.  In this case saveLR? will be false.
  1436.     The reason for this is that we can sometimes consolidate register
  1437.     saving/restoring if the current routine has less locals than a routine
  1438.     it's calling - we can save the "extra" regs as if they were locals
  1439.     belonging to the caller, not the callee, and so not have to do it on
  1440.     each call to the callee.  But this scheme does take a bit more space,
  1441.     which is why we currently only do it for leaf calls.  It could easily
  1442.     be extended if needed.
  1443.     
  1444.     I did try an idea to not bother saving uninitialized locals, and it
  1445.     worked, but I don't want to encourage leaving locals uninitialized so
  1446.     I removed it!
  1447.     
  1448.     If it's a method, we save off the object base reg (r20), then move
  1449.     r12 to r20 (the caller will have put the new obj's addr in r12).
  1450. *)
  1451.  
  1452.  
  1453. \ setup_regs_for_prolog is factored out of compile_prolog even though
  1454. \ it's only called once, because compile_prolog is already too long!
  1455.  
  1456. : setup_regs_for_prolog  { #gprs #parms #fprs #fparms meth? callingLeaf?
  1457.                 \ srcReg# dstReg# #parms2move #fparms2move n -- }
  1458.  
  1459. \ first we compile code to save regs - vrs, then fprs, then gprs.
  1460.  
  1461. [ ppc? ] [if]
  1462.     $ 7C0061CE  move_vrs        \ stvx vn, 0, r12 - save VRs if necessary
  1463. [then]
  1464.     #fprs  $ D8000000  -8  move_regs    \ save FPRs
  1465.     #gprs  $ 90000000  -4  move_regs    \ save GPRs
  1466.  
  1467. \ now we compile code to move the parms over.  Note we're only 
  1468. \  allowing a max of 8 integer parms at present, though some suitably
  1469. \  modified version of the forward defn code below would allow more.
  1470.  
  1471.     GPRs -> parmsRegs
  1472.     #parms gpr_call_cnt 1cell stk_offset SP_reg true  move_parms
  1473.  
  1474.     #fprs 0>=
  1475.     IF    FPRs -> parmsRegs
  1476.         #fparms fpr_call_cnt 8 fstk_offset FSP_reg false  move_parms
  1477.     THEN
  1478.  
  1479. (* ***
  1480. \ $$$$ testing here -- see if I can initialize locals to zero.
  1481.  
  1482.     #gprs #parms -  0
  1483.     ?DO
  1484.         $ 38000000  32 #gprs - i + 21 << or  code,
  1485.     LOOP
  1486.     
  1487.     #fprs #fparms -  0
  1488.     ?DO
  1489.          $ FC007090  32 #fprs - i + 21 << or  code,
  1490.     LOOP
  1491.  
  1492. \ $$$$ end test
  1493. *** *)
  1494.  
  1495. [ ppc? ] [if]        \ in target compilation we don't use const data
  1496.                     \  pointers or temp objects
  1497.     CD_gpr#
  1498.     IF
  1499.         CDP
  1500.         3 FOR  nop,  NEXT            \ nops for padding in case needed
  1501.         -> CDP
  1502.         CD_gpr# select: GPRs
  1503.  
  1504.         CD_gpr#  0 -> CD_gpr#
  1505.  
  1506. \        const_data_start
  1507.         CD_GPR_loc
  1508.         b&d  >blit: GPRs  noRef >Atype: GPRs
  1509.         otFetch put: ivar> opType in GPRs  compile: GPRs
  1510.         >Agpr: GPRs
  1511.         
  1512.         -> CD_gpr#
  1513.         
  1514.         CD_gpr# >Bgpr: GPRs
  1515.         otAdd put: ivar> opType in GPRs  clear: ivar> subtype in GPRs
  1516.         compile: GPRs
  1517.     THEN
  1518.  
  1519. (*    Finally, if there are temp objects, we have to set up the frame pointer.
  1520.     This will point to the dummy "object" in the frame, whose ivars are the
  1521.     temp objects.  We use an internal local variable as the frame pointer -
  1522.     its gpr# is in TO_gpr# (and in zClass we patch locreg to identify itself 
  1523.     as this gpr).
  1524.     The frame pointer will contain the new RP value plus an offset -
  1525.     we use an offset of 16 in all situations (see earlier comment).
  1526. *)
  1527.     callingLeaf?  ?EXIT                \ no temp objects in leaf calls
  1528.     tempObj_block_size  0EXIT        \ out if there aren't any
  1529.  
  1530.     TO_gpr#  -> dstReg#
  1531.     $ 38000000  dstReg# 21 << or  RP<<16 or
  1532.     16 or  code,                    \  addi reg#, RP, 16
  1533. [then]
  1534. ;
  1535.  
  1536.  
  1537. : make_leaf_frame  { meth? origFramesize framesize offs \ frameDone? -- }
  1538.  
  1539.     false -> frameDone?
  1540.         meth?
  1541.         IF    (*    it's a method, so we may need to save r20, and in this
  1542.                 case we can also allocate the frame via stwu, since without
  1543.                 a saved LR, the saved r20 will be leftmost in the frame.
  1544.                 The only situation where we don't need to do save r20 is when
  1545.                 the new value of r20 is r20 itself.  This will happen in the
  1546.                 case of a bind to self if there's no embedded object offset.
  1547.                 The new addr to put into r20 is ref'd by the top of cstk.
  1548.             *)
  1549.  
  1550.             1 operands
  1551.             refType: opnd1  gprRef =
  1552.             IF    reg: opnd1 20 =  -> dont_save_r20?  THEN
  1553.  
  1554.             dont_save_r20?
  1555.             IF            \ we only just decided, so we have to adjust the
  1556.                         \  frame.  If the original framesize wasn't 8-byte
  1557.                         \  aligned, we assume it was 4-byte aligned, and
  1558.                         \  go back by 8 bytes.  The main reason we bother 
  1559.                         \  with this adjustment is that sometimes the frame
  1560.                         \  will disappear altogether.
  1561.                 origFramesize 7 and
  1562.                 IF    8 ++> offs  -8 ++> frameSize  -8 ++> svFrameSize
  1563.                     -8 ++> frame_offs
  1564.                 THEN
  1565.             ELSE        \ we compile the code to save r20.  The saved
  1566.                         \  r20 goes leftmost in the frame.
  1567.                 20 select: GPRs
  1568.                 CDP put: ivar> lastRefCDP in GPRs        \ we're about to ref it
  1569.                 $ 94000000  RP<<16 or  obj_base_reg  21 << or
  1570.                 offs or code,                            \  stwu  r20, -framesize(RP)
  1571.                 true -> frameDone?
  1572.                 opnd1  20  get_to_this_gpr
  1573.             THEN
  1574.         THEN
  1575.     
  1576.     \ now if we need a frame and we haven't created it already, we
  1577.     \  do it here:
  1578.  
  1579.         framesize  frameDone? not and
  1580.         IF    $ 38000000  RP_reg 21 << or  RP<<16 or
  1581.             offs or code,            \ allocate frame by compiling
  1582.         THEN                        \  addi RP, RP, -framesize
  1583. \        true -> frameDone?
  1584. ;
  1585.  
  1586. : make_xaligned_frame  { meth? offs -- }
  1587.  
  1588.     $ 7E208B78    code,            \    mr        r0, RP
  1589.     $ 3A310100    offs or code,    \    addi    RP, -framesize
  1590.     $ 56310000                    \    rlwinm    RP, RP, 0, 0, 31-xalignment
  1591.         31 xalignment - 2* or code,
  1592.     $ 90110000    code,            \    stw        r0, (RP)
  1593.     LR>r0        code,            \    mflr    r0
  1594.     $ 90110004    code,            \    stw        r0, 4(RP)
  1595.  
  1596.     meth?
  1597.     IF                            \ we need to save r20 in the frame and then
  1598.                                 \  copy r12 to r20 (the new obj base addr).
  1599.                                 \  The saved r20 goes straight after the saved
  1600.                                 \  LR in the frame - offset 8.
  1601.         local?
  1602.         IF    true -> dont_save_r20?
  1603.         ELSE
  1604.             $ 90000008  RP<<16 or
  1605.             obj_base_reg  21 << or  code,    \ stw    r20, 8(RP)
  1606.             $ 7D946378  code,                \ mr    r20, r12
  1607.         THEN
  1608.     THEN
  1609. ;
  1610.  
  1611.  
  1612. : make_nonleaf_frame  { meth? offs -- }
  1613.  
  1614.     LR>r0  code,                \  mflr  r0
  1615.     $ 94000000  RP<<16 or
  1616.     offs or code,                \  stwu  r0, -framesize(RP)
  1617.                                 \ (this saves LR and allocates the frame
  1618.                                 \  in one hit)
  1619.     meth?
  1620.     IF                            \ we need to save r20 in the frame and then
  1621.                                 \  copy r12 to r20 (the new obj base addr).
  1622.                                 \  The saved r20 goes straight after the saved
  1623.                                 \  LR in the frame - offset 4.
  1624.         local?
  1625.         IF    true -> dont_save_r20?
  1626.         ELSE
  1627.             $ 90000004  RP<<16 or
  1628.             obj_base_reg  21 << or  code,    \ stw    r20, 4(RP)
  1629.             $ 7D946378  code,                \ mr    r20, r12
  1630.         THEN
  1631.     THEN
  1632. ;
  1633.  
  1634.  
  1635. : COMPILE_PROLOG  { #gprs #parms #fprs #fparms callingLeaf? meth?
  1636.                     \ origFramesize framesize n offs -- }
  1637.  
  1638.     false -> dont_save_r20?
  1639.  
  1640.     local?
  1641.     IF    0
  1642.     ELSE
  1643.         #gprs 0 max  -> #gprs            \ just in case
  1644.         #fprs 0 max  -> #fprs
  1645.         #gprs cells  #fprs 3 << +  #VL 4 << +
  1646.     THEN
  1647.  
  1648.     tempObj_block_size  ?dup
  1649.     IF                \ we have a temp object frame - in this case we always
  1650.                     \  use an offset of 16 above RP (see earlier comment).
  1651.         +  16 +
  1652.     ELSE
  1653.     
  1654.         callingLeaf?
  1655.         NIF  cell+  THEN                    \ if not a leaf call, we save LR
  1656.  
  1657.         meth?
  1658.         local? not and    IF   cell+  THEN    \ if method, we normally save r20
  1659.     THEN
  1660.  
  1661.     dup -> origFramesize            \ save unaligned framesize
  1662.  
  1663. \ now we align framesize to whatever we need to align it to - at least 8-byte
  1664. \  (2**3) alignment, but maybe more.  Currently the max is 16.
  1665.  
  1666.     3  xalignment max  #align_2**n
  1667.     -> framesize
  1668.  
  1669.     framesize negate $ ffff and  -> offs
  1670.  
  1671.     framesize -> svFramesize        \ for compile_epilog
  1672.     framesize -> frame_offs            \ initial offset for storing into frame (from right)
  1673.                                     \ *** Note - assumes frame is already allocated
  1674.                                     \ when frame_offs is used - frame_offs
  1675.                                     \ must be positive!! ***
  1676.     #gprs -> sv#gprs
  1677.     #fprs -> sv#fprs
  1678.  
  1679.     callingLeaf?
  1680.     IF
  1681.         meth? origFramesize framesize offs  make_leaf_frame
  1682.  
  1683.     ELSE            \ not a leaf, and we're compiling the prolog.
  1684.  
  1685.         CDP dup -> basic_block_start  -> backstop_CDP
  1686.         
  1687.         xalignment 3 >
  1688.         IF
  1689.             meth?  offs  make_xaligned_frame
  1690.         ELSE
  1691.             meth?  offs  make_nonleaf_frame
  1692.         THEN
  1693.     THEN
  1694.  
  1695.     local?  ?EXIT        \ if an internal defn in a local section, we're done
  1696.  
  1697.     #gprs #parms #fprs #fparms meth? callingLeaf?  setup_regs_for_prolog
  1698. ;
  1699.  
  1700.  
  1701. : COMPILE_EPILOG  { callingLeaf? meth? \ reg# n -- }
  1702.     
  1703.     callingLeaf?
  1704.     NIF
  1705.         xalignment 3 >
  1706.         IF        $ 80000004
  1707.         ELSE    $ 80000000
  1708.         THEN
  1709.         RP<<16 or  code,    \  lwz   r0, (RP) - or 4(RP) if this is an xaligned frame
  1710.         r0>LR code,            \  mtlr  r0
  1711.     THEN
  1712.  
  1713.     svFrameSize  -> frame_offs
  1714.  
  1715.     meth?
  1716.     IF            \ it's a method, so we may have saved r20.  If we're calling a leaf,
  1717.                 \  it's at 0(RP), otherwise at 4(RP) with the saved LR at 0(RP).
  1718.         dont_save_r20?
  1719.         NIF    $ 80000000  RP<<16 or  4 callingLeaf? not and  or
  1720.             obj_base_reg 21 << or  code,        \  lwz  r20, 0/4(RP)
  1721.         THEN
  1722.     THEN
  1723.     
  1724.     local?
  1725.     NIF        \ we compile code to restore regs - vrs, then fprs, then gprs.
  1726.     [ ppc? ] [if]
  1727.         $ 7C0060CE move_vrs        \ lvx  vn, 0, r12 - restore VRs if nec
  1728.     [then]
  1729.         sv#fprs  $ C8000000  -8  move_regs        \ restore FPRs
  1730.         sv#gprs  $ 80000000  -4  move_regs        \ restore GPRs
  1731.     THEN
  1732.  
  1733.     xalignment 3 >
  1734.     IF
  1735.         $ 82310000    code,            \ lwz  RP, (RP)    - gets rid of xaligned frame
  1736.         EXIT
  1737.     THEN
  1738.     
  1739.     svFramesize
  1740.     IF    $ 38100000  RP_reg 21 << or  RP<<16 or
  1741.         svFramesize or code,        \ addi RP, RP, framesize
  1742.                                     \  - gets rid of normal frame
  1743.     THEN
  1744. ;
  1745.  
  1746.  
  1747. false    value    cLeaf?        \ global because we need them after the call
  1748. false    value    cMeth?        \ - see call_h in ppc5
  1749.  
  1750.  
  1751. :f SETUP_NORMAL_CALL  { #gprs #fprs -- }
  1752.     debug? if
  1753.         ." setup_normal_call called with " #gprs . #fprs . cr
  1754.         ." calling a method? " cmeth? if ." yes" else ." no" then cr
  1755.         printall: cstk  cr
  1756.     then
  1757.  
  1758. \ First, bitter experience shows, for equalization to work, we MUST
  1759. \  have a few free regs!!
  1760.  
  1761.     size: cstk 7 >= IF  spill  THEN
  1762.  
  1763.     cMeth?
  1764.     IF        \ method call - top of cstk is obj base addr, which we have
  1765.             \  to put in r12 for the call.  We CAN allow recompiling
  1766.             \  of a reg move here, so we temporarily restore the old
  1767.             \  value of basic_block_start.
  1768.         1 operands
  1769.         debug? if
  1770.             ." obj base addr to be moved to r12: "  print: opnd1
  1771.         then
  1772.         opnd1 12 get_to_this_gpr
  1773.     THEN
  1774.  
  1775.     0 >size: cstk2
  1776.     #gprs 0
  1777.     ?DO    i 3+ >gpr: res1
  1778.         res1 push: cstk2
  1779.     LOOP
  1780.  
  1781.     #fprs 0<  IF ." oh no!!" 1 die THEN
  1782.     0 >size: fcstk2
  1783.     #fprs 0
  1784.     ?DO    i 1+  >fpr: res1
  1785.         res1 push: fcstk2
  1786.     LOOP
  1787. ;f
  1788.  
  1789.  
  1790. : SETUP_FAST_CALL  { c#P c#PL c#FP c#FPL \ reg# -- }
  1791.  
  1792. (*    called for calls to leaf routines.  We do the "prolog" work here in the
  1793.     caller instead.
  1794. *)
  1795.     debug? if
  1796.         ." setting up fast call" cr
  1797.         ." calling a method? " cmeth? if ." yes" else ." no" then cr
  1798.         ." c#P " c#P . ." c#PL " c#PL . ." c#FP " c#FP . ." c#FPL " c#FPL . cr
  1799.     then
  1800.  
  1801. \ first we save the regs that the caller will use, and that we haven't already
  1802. \  saved.  We do this by calling compile_prolog with the appropriate reg
  1803. \  counts.  We pass zero for the number of parms, since we handle those
  1804. \  separately below.
  1805.  
  1806.     #PL                    \ the number of GPRs we're using
  1807. [ ppc? ] [if]
  1808.     CD_gpr# 0= -        \ if we haven't allocated a const data pointer
  1809.                         \  yet, we might still be going to do it later 
  1810.                         \  in the defn, so to be safe we have to 
  1811.                         \  assume we're going to need the extra GPR.
  1812. [then]
  1813.     c#PL min            \ that's the final number of GPRs to save
  1814.  
  1815.     0                            \ pass zero as #parms
  1816.     #FPL c#FPL min                \ the number of FPRs to save
  1817.     0                            \ pass zero as #fparms
  1818.     true  cMeth?  compile_prolog
  1819.  
  1820.     0 >size: cstk2  0 >size: fcstk2
  1821.  
  1822. \ now we handle the parms.  First we look after any stack cells that have to 
  1823. \  go to regs - this will only happen if our default gpr_call_cnt/fpr_call_cnt
  1824. \  is greater than the number of named parms of that type.
  1825.  
  1826.     gpr_call_cnt c#P -  0 max  0
  1827.     ?DO
  1828.         i 3+ >GPR: res1
  1829.         res1 push: cstk2
  1830.     LOOP
  1831.  
  1832.     c#FP 0>=
  1833.     IF    fpr_call_cnt c#FP -  0 max  0
  1834.         ?DO
  1835.             i 1+ >FPR: res1
  1836.             res1 push: fcstk2
  1837.         LOOP
  1838.     THEN
  1839.  
  1840. \ now we look after the parms themselves - we set up for them to go straight to
  1841. \  their ultimate destination regs.
  1842.  
  1843.     c#P
  1844.     IF    31 -> reg#
  1845.         c#P
  1846.         FOR    reg# >GPR: res1  res1 push: cstk2
  1847.             1 --> reg#
  1848.         NEXT
  1849.     THEN
  1850.     
  1851.     c#FP 0>
  1852.     IF    31 -> reg#
  1853.         c#FP
  1854.         FOR    reg# >FPR: res1  res1 push: fcstk2
  1855.             1 --> reg#
  1856.         NEXT
  1857.     THEN
  1858. ;
  1859.  
  1860.  
  1861. : setup_with_gpr_mask  { #fprs -- }
  1862.     
  1863.     debug? if
  1864.         cr ." handle_gpr_mask called, with mask " extern_mask .h cr
  1865.     then
  1866.  
  1867.     0 >size: cstk2
  1868.  
  1869.     #extern_parm_cells  0
  1870.     ?DO
  1871.         extern_mask dup $ 8000 and
  1872.         NIF            \ OK, we include this one
  1873.             i 3+ >gpr: res1
  1874.             res1 push: cstk2
  1875.         THEN
  1876.         1 << $ FFFF and  -> extern_mask
  1877.     LOOP
  1878.     0 -> extern_mask        \ just in case
  1879.  
  1880.     #fprs 0<  IF ." oh no!!" 1 die THEN
  1881.     0 >size: fcstk2
  1882.     #fprs 0
  1883.     ?DO    i 1+  >fpr: res1
  1884.         res1 push: fcstk2
  1885.     LOOP
  1886.  
  1887.     debug? if
  1888.         ." cstk2 and fcstk2 now set up."
  1889.         printall: cstk  printall: cstk2 printall: fcstk printall: fcstk2
  1890.     then
  1891. ;
  1892.  
  1893. 0 value extern_fp_test
  1894.  
  1895. : SETUP_EXTERN_CALL
  1896.     { \ #parm_bytes #xs_bytes #xs_not_in_regs sys_SP_offs n --  }
  1897.  
  1898. \ For a general desription of what we're doing here, see CALL_EXTERN
  1899. \  in cg5.  We give the nuts and bolts detail here.
  1900.  
  1901. \    debug? if
  1902.     extern_fp_test if
  1903.         ." setting up external call" cr
  1904.         ." #extern_parm_cells   " #extern_parm_cells . cr
  1905.         ." #extern_result_cells " #extern_result_cells . cr
  1906.         ." #extern_FP_parms     " #extern_FP_parms . cr
  1907.         ." #extern_FP_results   " #extern_FP_results . cr
  1908.         ." cstk: " printall: cstk
  1909.         cr ." stk_offset " stk_offset .  cr
  1910.     then
  1911.  
  1912.     0 -> sys_SP_offs  0 -> #xs_not_in_regs
  1913.  
  1914. (* First we find the number of "excess parm bytes" - that is, the number
  1915.    of bytes in the parm area which won't fit in the 8 GPRs available
  1916.    for integer parms.
  1917. *)
  1918.  
  1919.     #extern_parm_cells cells  -> #parm_bytes
  1920.     #extern_parm_cells  8 -  0 max  -> #xs_parms
  1921.     #xs_parms cells  -> #xs_bytes
  1922.  
  1923. (* Now we have 2 cases to consider:
  1924.    1. #xs_parms = 0.  In this case the parms will all be in regs.  We
  1925.       don't have to worry about any memory-based parms.
  1926.       
  1927.    2. #xs_parms > 0.  In this case we need to have #xs_parms parm cells
  1928.          in the parm area of the frame.  Some of these might already be
  1929.          in regs, the others will already be in memory.  But they'll be
  1930.          in the wrong order.  Later parms will be lower in memory, while
  1931.          in the parm area later parms have to be higher in memory.
  1932.          So we won't try to use the mem area where the parm cells already
  1933.          are, but use the dummy frame, since we can change the order
  1934.          while we're moving the parms over.
  1935.          
  1936.          Then finally we have to get the first 8 parm cells into the regs.
  1937.          We do this with a slightly kludged form of our normal equalization.
  1938.  
  1939.     So in both cases we maintain our dummy frame.  We don't need to move
  1940.     the sys_SP (r1).  There's also no need to move our own SP, since it's
  1941.     irrelevant to the called routine and will be preserved.  We set
  1942.     adjust_stks? false so that equalize_for_call (where we've been called
  1943.     from) won't alter it.
  1944. *)
  1945.  
  1946.     #xs_parms
  1947.     IF    size: cstk cells  negate  24 -
  1948.         stk_offset  +  -> sys_SP_offs
  1949.  
  1950.     (* Now we have to store off any of the excess parms which happen to be
  1951.           in regs (or literals on cstk).  This is easiest if we go from the
  1952.           top of cstk downwards, i.e. we start at the end of the parm list and
  1953.           come backwards. The calling convention dictates that we store these
  1954.           parms from the high-addr end of the parm area and come downwards in
  1955.           memory.  Our initial SP offset is thus the number of parm bytes, plus
  1956.           the size of the linkage area (24), minus 4 so that we're looking
  1957.           at the last parm instead of just past it.
  1958.        *)
  1959.  
  1960.         size: cstk  #xs_parms min  -> n            \ n = no of xs parms in regs
  1961.         #parm_bytes  20 +  -> sys_SP_offs
  1962.         
  1963.         #xs_parms n -  -> #xs_not_in_regs        \ we need this shortly
  1964.         n 1+ 1
  1965.         ?DO    i stk: cstk
  1966.             cstk sys_SP_reg sys_SP_offs false  push_to_mem
  1967.             1cell --> sys_SP_offs
  1968.         LOOP
  1969.         size: cstk  n -  >size: cstk
  1970.     THEN
  1971.  
  1972. (* now if there are any xs parms which weren't originally in regs, we
  1973.    have to move them over.  sys_SP_offs is OK already.  The initial
  1974.    SP offset is already in stk_offset, since we start from the
  1975.    latest parm that we pushed onto the mem part of our data stack.
  1976.    As we move the parms, we increment stk_offset since when we
  1977.    finish the loop, we need stk_offset pointing to the next parm up,
  1978.    which will be the first to be loaded into a reg by the equalization.
  1979.    Note that we go UP in memory in the data stack, and continue coming
  1980.    DOWN in the parm area.
  1981. *)
  1982.  
  1983.     #xs_not_in_regs  0>
  1984.     IF    0 select: GPRs
  1985.         #xs_not_in_regs
  1986.         FOR
  1987.             SP_reg        stk_offset     0        compPull: GPRs
  1988.             sys_SP_reg    sys_SP_offs    false    compPush: GPRs
  1989.             1cell ++> stk_offset  1cell --> sys_SP_offs
  1990.         NEXT
  1991.     THEN
  1992.     
  1993. \ Now we set up cstk2 ready for equalization.  
  1994.  
  1995.     extern_mask
  1996.     IF                \ there are FP parms, so the setup is special
  1997.         #extern_FP_parms  setup_with_gpr_mask
  1998.     ELSE
  1999.         #extern_parm_cells 8 min
  2000.         #extern_FP_parms
  2001.         setup_normal_call
  2002.     THEN
  2003.  
  2004.     debug? if
  2005.         ."   # extern parm cells " #extern_parm_cells . cr
  2006.         ."   # excess parm cells " #xs_parms . cr
  2007.         ."   # excess parm cells not in regs " #xs_not_in_regs . cr
  2008.         ."   #extern_FP_parms " #extern_FP_parms . cr
  2009.         ."  ready to equalize:" cr
  2010.         printall: cstk  printall: cstk2
  2011.         printall: fcstk printall: fcstk2
  2012.     then
  2013.  
  2014.     false -> adjust_stks?
  2015.     update_refcnts
  2016. ;
  2017.  
  2018.  
  2019. : EQUALIZE_FOR_CALL  { xt \ c#P c#PL c#FP c#FPL float? cEntry? hndlr -- xt' }
  2020.  
  2021. (*    xt will be zero if we're not actually  calling - such as
  2022.     at EXIT.  It will be 1 if this is an external call.  (0 or odd
  2023.     numbers can't ever be valid xts.)  In other cases it's a normal
  2024.     Mops xt, which is the addr of the flag bytes of a definition.  The
  2025.     code starts 2 bytes later.
  2026.     c#P etc are the number of named parms etc. for the called word.
  2027. *)
  2028.     debug? if
  2029.         ." equalize_for_call called - cstk:" cr  printall: cstk
  2030.     then
  2031.  
  2032. \    true -> equalizing?
  2033.  
  2034.     0 -> c#P  0 -> c#PL
  2035.     0 -> c#FP  0 -> c#FPL
  2036.     false -> cLeaf?  false -> cMeth?  false -> float?
  2037.     GPRs -> eq_regs
  2038.  
  2039.     xt
  2040.     NIF            \ this is really an EXIT - just set up for equalization
  2041.         debug? if
  2042.             ." not a call - gpr_rtn_cnt = "  gpr_rtn_cnt . cr
  2043.         then
  2044.         get_rtn_cnts  setup_normal_call
  2045.         true -> adjust_stks?                        \ just in case
  2046.         
  2047.     ELSE        \ we're really calling
  2048.         xt  1 and
  2049.         IF        \ external call - parms are handled differently
  2050.             setup_extern_call
  2051.             true -> float?            \ external calls can do anything!
  2052.         ELSE
  2053.                 \ normal Mops call - get flags, #parms and #rslts from callee
  2054.  
  2055.             xt 2- w@  -> hndlr
  2056.             
  2057.             xt c@                        \ get flags and #results byte
  2058.             dup $ 80 and 0<>  -> cLeaf?
  2059.                 $ 10 and 0<>  -> float?
  2060.  
  2061.             xt 1+ c@                    \ #parms & #locals are in this byte
  2062.             dup 4 >>    -> c#P
  2063.             15 and        -> c#PL
  2064.  
  2065.             hndlr $ FF and  $ 40 =  -> cMeth?
  2066.                         \ methods are marked by hndlr code $BE40 or $BD40
  2067.             hndlr $ BE05 =            -> cEntry?
  2068.  
  2069.             float?
  2070.             IF            \ we have FP flag bytes - 4 bytes, of which
  2071.                         \  we're currently only using the last 2, with
  2072.                         \  analogous meaning to the above:
  2073.                 4 ++> xt
  2074.                 xt 1+ c@
  2075.                 dup 4 >>    -> c#FP
  2076.                 15 and        -> c#FPL
  2077.             THEN
  2078.     
  2079.             cLeaf?            \ are we calling a leaf routine?
  2080.             IF
  2081.                 max_called_#PL c#PL max        -> max_called_#PL
  2082.                 max_called_#FPL c#FPL max    -> max_called_#FPL
  2083.                 c#P c#PL c#FP c#FPL setup_fast_call
  2084.             ELSE
  2085.                 cEntry?
  2086.                 IF    c#P c#FP
  2087.                 ELSE
  2088.                     gpr_call_cnt c#P max
  2089.                     fpr_call_cnt c#FP max
  2090.                 THEN
  2091.                 setup_normal_call
  2092.             THEN
  2093.         THEN
  2094.     THEN
  2095.  
  2096.     debug? if
  2097.         ." stacks set up for equalization:" cr
  2098.         printall: cstk  printall: cstk2
  2099. \        false -> debug?
  2100.     then
  2101.  
  2102.     set_backstop_CDP
  2103.                 \ can't allow recompiling of regs during equalization,
  2104.                 \  since we must assume callee wants them all even if
  2105.                 \  they haven't been used here.  Also as we're setting
  2106.                 \  backstop_CDP, we don't need to bother putting this
  2107.                 \  equalization into eq_ranges, since we'd never look at
  2108.                 \  it anyway.
  2109.                 
  2110.     true -> equalizing?
  2111.  
  2112.     false fix_duplicates
  2113.     false equalize_depths
  2114.     false equalize_refs
  2115.     update_refcnts
  2116.     adjust_stks? IF  adjust_stks  ELSE  true -> adjust_stks?  THEN
  2117.     
  2118.     debug? if ." final stacks - should be the same:" cr
  2119.         printall: cstk  printall: cstk2
  2120.     then
  2121.     
  2122.     set_backstop_CDP        \ can't hoist anything over a call, no matter
  2123.                             \  what!
  2124.     false -> equalizing?
  2125. ;
  2126.  
  2127.  
  2128. \        =========================================================
  2129. \                            CONDITIONALS
  2130. \        =========================================================
  2131.  
  2132. (*    The conditionals are different enough for the PowerPC that we'll
  2133.     rewrite them - in particular, we do some work at basic block boundaries.
  2134.    
  2135.    For >mark and <resolve, which must go with a branch instruction, we assume
  2136.    the branch has just been compiled.
  2137.    
  2138.     A >mark pushes the entire cstk, so that everything can be equalized at
  2139.     >resolve time, then it pushes a check value for ?pairs.  It also pushes
  2140.     the branch addr onto control_stk, and a flag byte onto control_flags.
  2141.     We use these separate stacks instead of the data stack, since we often
  2142.     want to look at what's on them at various places when we might have
  2143.     sundry items on the data stack.
  2144.     
  2145.     Here's the bit assignments for the flag bytes in control_flags:
  2146.     
  2147.     $01        this was pushed by <mark- i.e. this is a loop.
  2148.     $02        other basic block is dead (had an unconditional EXIT)
  2149.     $04        this basic block is dead
  2150.     $08        extra item pushed by ?DO (otherwise we push zero)
  2151.  
  2152.     $80        always branch (i.e. conditionally compiling on "false")
  2153.     $40        never branch  (i.e. conditionally compiling on "true")
  2154.  
  2155.     For a forward "always branch" situation, >resolve actually deletes the
  2156.     code being branched over (which could never be executed).
  2157. *)
  2158.  
  2159. false    value    will_skip?        \ used globally.  True while we're processing
  2160.                                 \  conditionally compiled code when the
  2161.                                 \  condition was "false".
  2162.  
  2163. false    value    cond_comp?        \ only used locally - tells >MARK that
  2164.                                 \  we're going into conditional compilation,
  2165.                                 \  so it doesn't need to do anything since
  2166.                                 \  at that point we've done it already.
  2167.  
  2168.  
  2169.  
  2170. : >MARK
  2171.     debug? if
  2172.         ." >mark called - cond_comp? "
  2173.         cond_comp? if ."  true" else ."  false" then  cr
  2174.     then
  2175.  
  2176.     cond_comp?                \ if conditional compilation, we've handled it already
  2177.     IF  false -> cond_comp?
  2178.         EXIT
  2179.     THEN
  2180.  
  2181.     adjust_stks                    \ can't have a non-zero stk adjustment here either
  2182.     save: cstk  save: fcstk        \ save cstk and fcstk on data stk
  2183.     120                            \ for ?pairs
  2184.  
  2185.     CDP dup  -> basic_block_start
  2186.     4-  push: control_stk
  2187.     0 push: control_flags
  2188. ;
  2189.  
  2190. : >RESOLVE  { chk \ branchCDP -- }
  2191.     debug? if
  2192.         ." >resolve called - control_stk:"  printall: control_stk
  2193.     then
  2194.  
  2195.     chk 120 ?pairs
  2196.     adjust_stks
  2197.     pop: control_stk -> branchCDP
  2198.     pop: control_flags drop
  2199.     CDP branchCDP -  branchCDP 2+ w!
  2200.  
  2201.     branchCDP -> frNxtDP
  2202.     
  2203. (* Now if backstop_CDP has been moved to within the conditional section
  2204.    (by a call to another word coming there, say), we need to move it
  2205.    to where we are now, since we can't hoist a fetch into the middle
  2206.    of a conditional section, since that would mean that it mightn't get
  2207.    executed when we want it to be - not to mention that it would break
  2208.    a resolved conditional branch offset.
  2209. *)
  2210.     backstop_CDP branchCDP u>
  2211.     IF    set_backstop_CDP  THEN
  2212.     CDP -> basic_block_start
  2213. ;
  2214.  
  2215.  
  2216. : >RESOLVE_COND_COMPILATION  { \ flgs -- }
  2217.     pop: control_stk -> startCDP
  2218.     pop: control_flags  -> flgs
  2219.  
  2220.     debug? if
  2221.         ." >resolve_cond_compilation called" cr
  2222.         ." startCDP "    startCDP .h cr
  2223.         ." flgs "        flgs .h cr
  2224.     then
  2225.  
  2226.     flgs $ 80 =
  2227.     IF        \ "branch always" - i.e. delete everything from there to here
  2228.         make_altered_regs_unknown    \ mustn't allow matches - code to
  2229.                                     \  be deleted!
  2230.         startCDP -> CDP
  2231.         startCDP -> basic_block_start
  2232.         restore: fcstk  restore: cstk  update_refcnts
  2233.         false -> will_skip?
  2234.     ELSE
  2235.         restore: fcstk2  restore: cstk2
  2236.     THEN
  2237.     debug? if
  2238.         ." control_flags at end of >resolve_cond_compilation" cr
  2239.         printall: control_flags
  2240.     then
  2241. ;
  2242.  
  2243.  
  2244. : >RESOLVE&EQUALIZE  ( <saved cstk state> ) { chk \ flgs branchCDP -- }
  2245.  
  2246.     debug? if
  2247.         ." >resolve&equalize called - control_stk:"  printall: control_stk
  2248.         ." control_flags:" printall: control_flags
  2249.         ." cstk:" printall: cstk
  2250.     then
  2251.  
  2252.     chk 120 ?pairs
  2253.     adjust_stks
  2254.  
  2255.     1 stk: control_flags  -> flgs
  2256.     flgs $ C0 and
  2257.     IF    >resolve_cond_compilation  EXIT  THEN
  2258.  
  2259.     pop: control_stk -> branchCDP
  2260.     pop: control_flags drop
  2261.  
  2262.     flgs 2 and
  2263.     IF                \ There was an (unconditional) EXIT in the other basic block,
  2264.                     \  so we don't have to bother equalizing.  We just resolve the
  2265.                     \  branch as at equalize_for_conditional above.
  2266.                     
  2267.         restore: fcstk2  restore: cstk2
  2268.                 \ just get rid of saved cstk & fcstk states - they're dead
  2269.                 
  2270.         debug? if
  2271.             ." other basic block had an EXIT - skipping equalization.  cstk:" cr
  2272.             printall: cstk  cr
  2273.         then
  2274.         
  2275.         true
  2276.         
  2277.     ELSE
  2278.         flgs 4 and
  2279.         IF            \ there was an (unconditional) EXIT in THIS basic block, so
  2280.                     \  while we don't have to equalize, we do have to use the saved
  2281.                     \  cstk state.
  2282.             restore: fcstk  restore: cstk
  2283.             debug? if
  2284.                 ." this basic block had an EXIT - skipping equalization.  cstk:" cr
  2285.                 printall: cstk  cr
  2286.             then
  2287.  
  2288.             true
  2289.         ELSE        \ no EXIT
  2290.             false
  2291.         THEN
  2292.     THEN
  2293.  
  2294. \ skip equalization?
  2295.         
  2296.     IF    branchCDP CDP  resolve_branch
  2297.         branchCDP -> frNxtDP
  2298.         update_refcnts
  2299.  
  2300.     ELSE            \ do equalization
  2301.         branchCDP equalize_for_conditional
  2302.                                 \ resolves the branch as well, as it's all
  2303.                                 \  tied in with the equalization code in a
  2304.                                 \  nastily complex way!
  2305.     THEN
  2306.     branchCDP -> startCDP  make_altered_regs_unknown
  2307.                                 \ any regs altered in the conditional code
  2308.                                 \  can't now have their values used because
  2309.                                 \  we don't know what was executed!
  2310.                                 
  2311.     backstop_CDP branchCDP u>        \ see comment above in >resolve
  2312.     IF    set_backstop_CDP  THEN
  2313.     CDP -> basic_block_start
  2314.  
  2315.     debug? if
  2316.         ." control_flags at end of >resolve&equalize" cr
  2317.         printall: control_flags
  2318.     then
  2319. ;
  2320.  
  2321.  
  2322. : <MARK
  2323.     debug? if
  2324.         ." <mark called - calling prepare_for_loop" cr
  2325.     then
  2326.  
  2327.     prepare_for_loop                    \ sets up cstk for what we have to 
  2328.                                         \  equalize to in the loop
  2329.     save: cstk  save: fcstk  121
  2330.  
  2331.     CDP push: control_stk
  2332.     1    push: control_flags                \ 1 = this is a <mark, i.e. a loop
  2333.     CDP -> loop_start
  2334. ;
  2335.  
  2336.  
  2337. :f FIX_CONTAINING_LOOP  { \ index -- }
  2338.     0 -> loop_start
  2339.     false -> will_skip?                    \ shouldn't need this, but I want to
  2340.                                         \  be sure
  2341.     size: control_stk  0EXIT            \ there can't be a containing loop
  2342.     size: control_stk 1-  -> index
  2343.     BEGIN                                \ loop over conditionals till we
  2344.                                         \  maybe find a loop
  2345.         index at: control_flags 1 and
  2346.         IF                                \ got it!
  2347.             index at: control_stk  -> loop_start  EXIT
  2348.         THEN
  2349.         1 --> index
  2350.         index 0<
  2351.     UNTIL
  2352. ;f
  2353.  
  2354. 0    value    <resolve_target            \ used by +LOOP
  2355.  
  2356. : <RESOLVE  ( <saved cstk state> )
  2357.         { chk \ markCDP branchCDP svBranch -- }
  2358.     
  2359.     debug? if
  2360.         ." <resolve called" cr
  2361.     then
  2362.  
  2363.     chk 121 ?pairs
  2364.     
  2365. \ note: not safe to do hoist_invariants here, since equalization
  2366. \  might move a reg, making the dest reg not invariant!
  2367.  
  2368.     1 stk: control_stk  dup -> markCDP  -> <resolve_target
  2369.     pop: control_flags  drop
  2370.  
  2371.     CDP 4-  -> branchCDP
  2372.     branchCDP @  -> svBranch        \ save and remove the branch in case
  2373.     4 --> CDP                        \  equalize_for_loop compiles something
  2374.  
  2375.     markCDP equalize_for_loop
  2376.     hoist_invariants                \ let's try it here!
  2377.     pop: control_stk -> markCDP
  2378.  
  2379.     svBranch code,                    \ replace the branch
  2380.     CDP 4-  -> branchCDP
  2381.  
  2382.     markCDP branchCDP -                \ offset to go in branch instrn
  2383.     branchCDP 2+ w!
  2384.  
  2385. (*    Now similarly to the >resolve situation, if backstop_CDP has been moved 
  2386.     to within the loop (by a call to another word coming there, say), we 
  2387.     need to move it to where we are now.  We can't hoist a fetch into the 
  2388.     middle of any conditional section since it mightn't get executed,
  2389.     and anyway in the loop situation it would be pretty stupid to hoist
  2390.     a fetch INTO a loop!!
  2391. *)
  2392.     backstop_CDP markCDP u>
  2393.     IF    set_backstop_CDP  THEN
  2394.  
  2395.     fix_containing_loop
  2396. ;
  2397.  
  2398.  
  2399. : (ELSE)  { \ flgs -- }
  2400.     debug? if
  2401.         ." (else) called - control_stk:"  printall: control_stk
  2402.     then
  2403.  
  2404.     1 stk: control_stk  -> startCDP
  2405.     adjust_stks
  2406.     make_altered_regs_unknown
  2407.     1 stk: control_flags -> flgs    \ control_flags will be popped by
  2408.                                     \  >resolve_cond_compilation or >resolve
  2409.     flgs $ C0 and
  2410.     IF                \ conditional compilation - special case.  We wind up
  2411.                     \  the IF-stub, then set up the ELSE-stub, rather like
  2412.                     \  do_conditional_compilation below.
  2413.         120 ?pairs
  2414.         >resolve_cond_compilation
  2415.     \    pop: control_flags  drop    \ >resolve doesn't get called from here
  2416.         flgs $ C0 xor                \ new flags byte
  2417.         dup $ 80 =  -> will_skip?
  2418.              push: control_flags
  2419.         CDP  push: control_stk
  2420.         save: cstk  save: fcstk
  2421.         120                        \ for ?pairs
  2422.         EXIT
  2423.     THEN
  2424.  
  2425.     startCDP    CDP 4-  =
  2426.     IF        \ nothing compiled in first section.   We just recompile the
  2427.             \ conditional branch, which is still set up in branch_instrn,
  2428.             \ with the condition inverted.
  2429.         4 --> CDP
  2430.         invert: branch_instrn  compile: branch_instrn
  2431.     ELSE
  2432.         $ BF090000                \ our temp code for the ELSE branch
  2433.         1 stk: control_stk  CDP -  $ FFFF and
  2434.         or  code,                \ until we resolve this branch, we leave the
  2435.                                 \  offset to the original conditional branch in
  2436.                                 \  the lo 16 bits.  This allows us to adjust if
  2437.                                 \  we end up deleting the ELSE branch.
  2438.     THEN
  2439.     >resolve
  2440.     restore: fcstk2  restore: cstk2
  2441.     save: cstk  save: fcstk  120
  2442.     CDP 4-            push: control_stk
  2443.     flgs 4 and 1 >>    push: control_flags        \ set "dead basic block" bit
  2444.                                             \  for right BB
  2445.     CDP -> basic_block_start
  2446.     save: cstk2  save: fcstk2
  2447.     restore: fcstk  restore: cstk  update_refcnts
  2448. ;
  2449.  
  2450.  
  2451. : DO_CONDITIONAL_COMPILATION  { invert? -- }
  2452.     debug? if
  2453.         ." doing conditional compilation"  cr
  2454.         printall: cstk  printall: control_stk
  2455.     then
  2456.  
  2457.     1 operands
  2458.     adjust_stks
  2459.     lit: opnd1 0<> invert? xor
  2460.     IF        $ 80   true -> will_skip?
  2461.     ELSE    $ 40
  2462.     THEN
  2463.     push: control_flags
  2464.     CDP push: control_stk        \ dummy
  2465.     save: cstk  save: fcstk
  2466.     120                        \ for ?pairs
  2467.  
  2468.     true -> cond_comp?        \ inhibits >MARK from doing anything, since
  2469.                             \  we've done it all already.  Note we haven't
  2470.                             \  compiled any branch.
  2471. ;
  2472.  
  2473.  
  2474. : PIF  { invert? \ flgs -- }
  2475.     debug? if
  2476.         ." PIF called" cr printall: cstk  printall: fcstk  cr
  2477.     then
  2478.     
  2479.     1 stk: cstk
  2480.     refType: cstk litRef =
  2481.     IF    invert? do_conditional_compilation  EXIT  THEN
  2482.     
  2483.     refType: cstk CRref <>
  2484.     IF                        \ not in a CR field - get it there
  2485.         " 0<>" evaluate        \ easy!
  2486.     THEN
  2487.     1 operands
  2488.     adjust_stks
  2489.     opnd1 invert? setup_conditional_branch
  2490.     reg: opnd1  dup select: CRs
  2491.     NIF  false -> using_CR0  THEN
  2492.     CDP put: ivar> lastRefCDP in CRs
  2493.     free: opnd1
  2494.     compile: branch_instrn
  2495. ;
  2496.